home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / paswiz15.zip / ARCVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-04  |  3KB  |  105 lines
  1. { This is a demonstration of the archive directory handling
  2.   provided by the Pascal Wizard's Library }
  3.  
  4.  
  5.  
  6. {$M $3000,0,0 }          { stack size, min heap, max heap (bytes) }
  7. {$D-}                    { debug info off }
  8. {$A-}                    { word alignment off (so use byte alignment) }
  9. {$I-}                    { don't crash on errors }
  10.  
  11.  
  12.  
  13. USES
  14.    Archives, Strings;
  15.  
  16.  
  17.  
  18. VAR
  19.    CurrentSize, OriginalSize: LongInt;
  20.    tmp, ErrCode: Integer;
  21.    Verbose: Boolean;
  22.    FileName, DateSt, TimeSt: String;
  23.  
  24.  
  25.  
  26. PROCEDURE WriteComma (Number: LongInt; FieldLen: Integer);
  27. VAR
  28.    N, R: String;
  29. BEGIN
  30.    Str(Number, N);
  31.    R := '';
  32.    WHILE Length(N) > 3 DO BEGIN
  33.       R := Right(N, 3) + ',' + R;
  34.       N := Left(N, Length(N) - 3);
  35.    END;
  36.    IF Length(N) > 0 THEN
  37.       R := N + ',' + R;
  38.    IF Right(R, 1) = ',' THEN
  39.       R := Left(R, Length(R) - 1);
  40.    IF Length(R) < FieldLen THEN
  41.       R := Dupe(FieldLen - Length(R), ' ') + R;
  42.    Write(R);
  43. END;
  44.  
  45.  
  46.  
  47. BEGIN
  48.    IF (ParamCount = 0) THEN BEGIN
  49.       WriteLn('ARCVIEW  Demo for the PasWiz Library archive directory routines');
  50.       WriteLn;
  51.       WriteLn('Syntax:');
  52.       WriteLn('   ARCVIEW [/V] arcname');
  53.       WriteLn;
  54.       WriteLn('Archives may be in the following formats:');
  55.       WriteLn;
  56.       WriteLn('   .ARC     .LZH     .ZIP');
  57.       WriteLn('   .ARJ     .PAK     .ZOO');
  58.       WriteLn;
  59.       WriteLn('(and associated self-extracting .EXE archives)');
  60.       WriteLn;
  61.       WriteLn('Just the filenames will be listed, unless the /V (verbose) switch is used.');
  62.    END
  63.    ELSE BEGIN
  64.       Verbose := FALSE;
  65.       FOR tmp := 1 TO ParamCount DO
  66.          IF Uppercase(ParamStr(tmp)) = '/V' THEN
  67.             Verbose := TRUE;
  68.       IF Verbose AND (ParamCount = 1) THEN BEGIN
  69.          WriteLn('Please specify the name of an archive.');
  70.          EXIT;
  71.       END;
  72.       FOR tmp := 1 TO ParamCount DO
  73.          IF Uppercase(ParamStr(tmp)) <> '/V' THEN BEGIN
  74.             FindFirstA(ParamStr(tmp), '*.*', ErrCode);
  75.             IF ErrCode <> 0 THEN BEGIN
  76.                WriteLn('Unable to open archive "', ParamStr(tmp), '"');
  77.                writeln(errcode);
  78.                EXIT;
  79.             END;
  80.             IF Verbose THEN BEGIN
  81.                WriteLn('Filename       Date       Time    CRC        Curr. Size    Orig. Size');
  82.                WriteLn('------------   --------   -----   --------   -----------   -----------');
  83.             END;
  84.             WHILE ErrCode = 0 DO BEGIN
  85.                FileName := GetNameA;
  86.                IF Verbose THEN BEGIN
  87.                   Write(FileName, Dupe(15 - Length(FileName), ' '));
  88.                   DateSt := Left(GetDateA, 6) + Right(GetDateA, 2);
  89.                   TimeSt := Left(GetTimeA, 5);
  90.                   Write(DateSt, '   ', TimeSt, '   ', GetCRCA);
  91.                   GetSizeA(OriginalSize, CurrentSize);
  92.                   WriteComma(CurrentSize, 14);
  93.                   WriteComma(OriginalSize, 14);
  94.                   WriteLn;
  95.                END
  96.                ELSE
  97.                   Write(FileName, Dupe(16 - Length(FileName), ' '));
  98.                FindNextA(ErrCode);
  99.             END;
  100.             CloseA;
  101.             IF NOT Verbose THEN WriteLn;
  102.          END;
  103.    END;
  104. END.
  105.